home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyGrowZones.p < prev    next >
Encoding:
Text File  |  1997-04-11  |  1.7 KB  |  95 lines  |  [TEXT/CWIE]
  1. unit MyGrowZones;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8.     procedure StartupGrowZones;
  9.     procedure ConfigureGrowZones(size: longint);
  10.     function MemoryCritical: boolean;
  11.     function EnoughSpace (total, contig: longint): boolean;
  12.     procedure IdleGrowZone; { Called by IdleStartup, you can call it yourself }
  13.  
  14. implementation
  15.  
  16.     uses
  17.         Memory, OSUtils, 
  18.         PreserveA5, MyCallProc, MyStartup, MyMemory;
  19.  
  20. {$ifc do_debug}
  21.     var
  22.         startup_check: integer;
  23. {$endc}
  24.  
  25.     var
  26.         gzh: Handle;
  27.         gz_size: longINt;
  28.  
  29.     function MyGrowZone (size: longint): longint;
  30.         var
  31.             saved_A5:Ptr;
  32.     begin
  33. {$unused(size)}
  34.         saved_A5 := SetPreservedA5;
  35.         if gzh <> nil then begin
  36.             MyGrowZone := MGetHandleSize(gzh);
  37.             MDisposeHandle( gzh );
  38.         end else begin
  39.             MyGrowZone := 0;
  40.         end;
  41.         RestoreA5(saved_A5);
  42.     end;
  43.  
  44.     function MemoryCritical: boolean;
  45.     begin
  46.         AssertDidStartup( startup_check );
  47.         MemoryCritical := gzh = nil;
  48.     end;
  49.  
  50.     function EnoughSpace (total, contig: longint): boolean;
  51.         var
  52.             t, c: longint;
  53.     begin
  54.         PurgeSpace(t, c);
  55.         EnoughSpace := not MemoryCritical & (t >= total) & (c >= contig);
  56.     end;
  57.  
  58.     procedure IdleGrowZone;
  59.         var
  60.             junk: OSErr;
  61.     begin
  62.         if gzh = nil then begin
  63.             junk := MNewHandle( gzh, gz_size );
  64.         end;
  65.     end;
  66.  
  67.     procedure ConfigureGrowZones(size: longint);
  68.     begin
  69.         DidStartup( startup_check );
  70.         StartupGrowZones;
  71.         gz_size := size;
  72.     end;
  73.     
  74.     function InitGrowZone(var msg: integer): OSStatus;
  75.     begin
  76. {$unused(msg)}
  77.         SetGrowZone(NewProc(@MyGrowZone,uppPascal44ProcInfo));
  78.         gzh := nil;
  79.         IdleGrowZone;
  80.         InitGrowZone := noErr;
  81.     end;
  82.  
  83.     procedure FinishGrowZone;
  84.     begin
  85.         if gzh <> nil then begin
  86.             MDisposeHandle( gzh );
  87.         end;
  88.     end;
  89.  
  90.     procedure StartupGrowZones;
  91.     begin
  92.         SetStartup(InitGrowZone, IdleGrowZone, 30, FinishGrowZone);
  93.     end;
  94.     
  95. end.